home *** CD-ROM | disk | FTP | other *** search
/ Ian & Stuart's Australian Mac 1993 September / September 93.iso / Archives / Applications / Text / Text Editors / Alpha 5.31 Folder / Tcl / SystemCode / fill.tcl < prev    next >
Encoding:
Text File  |  1993-01-25  |  2.2 KB  |  110 lines  |  [TEXT/ALFA]
  1. #=============================================================================
  2. #    'Fill' routines.
  3. #=============================================================================
  4.  
  5. proc fillParagraph {} {
  6.     set pos [getPos]
  7.     set start [paraStart $pos] 
  8.     set finish [paraFinish $pos]
  9.     goto $start
  10.     set text [fillText $start $finish]
  11.     replaceText $start $finish $text "\r"
  12.     goto $pos
  13. }
  14.  
  15. proc fillRegion {} {
  16.     set start [lineStart [getPos]]
  17.     set finish [selEnd]
  18.     goto $start
  19.     set text [fillText $start $finish]
  20.     replaceText $start $finish $text "\r"
  21. }
  22.     
  23. proc wrapParagraph {} {
  24.     set pos [getPos]
  25.     set start [paraStart $pos] 
  26.     set finish [paraFinish $pos]
  27.     goto $start
  28.     wrapText $start $finish
  29.     goto $pos
  30. }
  31.  
  32. proc wrapRegion {} {
  33.     set start [lineStart [getPos]]
  34.     set finish [selEnd]
  35.     if {$start == $finish} {
  36.         set finish [maxPos]
  37.     }
  38.     wrapText $start $finish
  39. }
  40.     
  41. proc paraStart {pos} {
  42.     set res [search -n -f 0 -r 1 {^[ \t]*$} $pos 0]
  43.     if {![string length $res]} {return 0}
  44.     return [nextLineStart [lindex $res 0]]
  45. }
  46.  
  47.  
  48. proc paraFinish {pos} {
  49.     set end [maxPos]
  50.     set res [search -n -f 1 -r 1 {^[ \t]*$} $pos $end]
  51.     if {![string length $res]} {return $end}
  52.     return [lindex $res 0]
  53. }
  54.  
  55.  
  56. proc oldParaStart {pos} {
  57.     set pos [lineStart $pos]
  58.     while {$pos > 0} {
  59.         set back [lineStart [expr $pos-1]]
  60.         if {$back < 0} {return 0}
  61.         if {[regexp "^\[ \t\]*\r$" [getText $back $pos]]} {return $pos}
  62.         set pos $back
  63.     }
  64.     return 0
  65. }
  66.  
  67.  
  68. proc oldParaFinish {pos} {
  69.     set end [maxPos]
  70.     while {$pos < $end} {
  71.         set next [nextLineStart $pos]
  72.         if {$pos == "-1"} {return $end}
  73.         if {[regexp "^\[ \t\]*\r$" [getText $pos $next]]} {return $pos}
  74.         set pos $next
  75.     }
  76.     return $end
  77. }
  78.  
  79.  
  80. # Remove text from window, transform, and insert back into window.
  81. proc fillText {from to} {
  82. # Get The text
  83.     set text [getText $from $to]
  84.     
  85. # Remove duplicated white space, carriage returns.
  86.     regsub -all "\[ \t\r\]+" $text " " text
  87.  
  88. # Insert left margins and carriage returns, doesn't end with a carriage return.
  89.     return [breakIntoLines $text]
  90. }
  91.  
  92. proc lineToParagraph {} {
  93.     global fillColumn
  94.     global leftFillColumn
  95.     saveVars
  96.     set fillColumn 10000
  97.     set leftFillColumn 0
  98.     fillRegion
  99.     restoreVars}
  100.  
  101. proc paragraphToLine {} {
  102.     global fillColumn
  103.     global leftFillColumn
  104.     saveVars
  105.     set fillColumn 75
  106.     set leftFillColumn 0
  107.     fillRegion
  108.     restoreVars}
  109.  
  110.